home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff1.arc / FLPTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-02-18  |  1.5 KB  |  88 lines
  1. PROGRAM GUARD;
  2.  
  3.  
  4. CONST
  5.  
  6.   ONE = 1.0;
  7.   HALF = 0.5;
  8.   ZERO = 0.0;
  9.   MINUSONE = -1.0;
  10.  
  11.  
  12. VAR
  13.  
  14.   RADIX : REAL;
  15.   PRECISION : REAL;
  16.   WIDTH : REAL;
  17.   WIDE : REAL;
  18.   ULPONE : REAL;
  19.   ULPRADIX : REAL;
  20.   ONEMINUS : REAL;
  21.   RADIXMINUS : REAL;
  22.   S,T,U :REAL;
  23.   X,Y,Z :REAL;
  24.  
  25.  
  26. BEGIN {GUARD}
  27.  
  28.    WIDE := ONE;
  29.    REPEAT
  30.  
  31.       WIDE := WIDE + WIDE;
  32.       X := WIDE + ONE;
  33.       Y := X - WIDE;
  34.       Z := Y - ONE;
  35.       UNTIL ( MINUSONE + ABS(Z)) >= ZERO;
  36.  
  37.  
  38.  Y := ONE;
  39.  REPEAT
  40.  
  41.  
  42.      RADIX := WIDE + Y;
  43.      Y := Y + Y;
  44.      RADIX := RADIX - WIDE;
  45.      UNTIL RADIX <> ZERO;
  46.      WRITELN ('RADIX = ',RADIX);
  47.  
  48.  
  49.  
  50.  PRECISION := ZERO;
  51.  WIDTH := ONE;
  52.  REPEAT
  53.  
  54.  
  55.      PRECISION := PRECISION + ONE;
  56.      WIDTH := WIDTH * RADIX;
  57.      Y := WIDTH + ONE;
  58.      UNTIL ( Y - WIDTH ) <> ONE;
  59.  
  60.  
  61. WRITELN ('PRECISION = ',PRECISION );
  62. WRITELN ('WIDTH = ',WIDTH );
  63. ULPONE := ONE/WIDTH;
  64. WRITELN ('CLOSEST RELATIVE SEPERATION FOUND IS ULPONE = ',ULPONE );
  65.  
  66.  
  67.   ONEMINUS := ( HALF - ULPONE ) + HALF;
  68.   ULPRADIX := RADIX * ULPONE;
  69.   RADIXMINUS := RADIX - ONE;
  70.   RADIXMINUS := (RADIXMINUS - ULPRADIX ) + ONE;
  71.  
  72.  
  73.      X := ONE - ULPONE;
  74.      Y := ONE - ONEMINUS;
  75.      Z := ONE - X;
  76.      S := RADIX - ULPRADIX;
  77.      T := RADIX - RADIXMINUS;
  78.      U := RADIX - S;
  79.  
  80.  
  81. IF (Y = ULPONE) AND (Z = ULPONE)
  82. AND (T = ULPRADIX) AND (U = ULPRADIX)
  83. THEN WRITELN('ADD/SUBTRACT HAS A GUARD DIGIT AS IT SHOULD')
  84. ELSE
  85. WRITELN('ADD/SUBTRACT LACKS GUARD DIGIT, CANCELLATION OBSCURED')
  86.  
  87. END {GUARD}.
  88.